home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PCTV3N3
/
386OPS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-07-20
|
3KB
|
118 lines
unit _386_Ops;
{Copyright (C) 1991..92, Midnight Beach. All rights reserved}
interface
procedure Install_386_Ops;
implementation
{$ifdef Windows} uses WinProcs; {$endif}
{$R-,S-,G+,B-}
{See note under "The replacer" to use this w/ TP 4 through 5.5}
{The replacement routines}
{$L c:\tpw\&tp6\_386_ops}
procedure LongMul386; far; external;
procedure LongDivMod386; far; external;
procedure LongShr386; far; external;
procedure LongShl386; far; external;
procedure TailPtr; far; external;
{Dummy routine to find RTL entry points}
procedure Dummy; near;
var
A, B: LongInt;
begin
A := A * B;
A := A div B;
A := A shl 5;
A := A shr 5;
end;
{The replacer}
const
ProcPrefixLen = {$ifopt G+} 4 {$else} 6 {$endif};
MulDivLen = 13; {Offset of RTL pointer from start of `line'}
ShxLen = 12; {Ditto}
InterOpLen = 10; {SizeOf(pointer) + }
{two moves from registers to stack vars}
{
The values above are for TP6 and TPW. For TP 4, 5, & 5.5, use:
PrefixLen = 6;
MulDivLen = 11;
ShxLen = 11;
InterOpLen = 10;
}
MulOfs = ProcPrefixLen + MulDivLen;
DivOfs = MulOfs + InterOpLen + MulDivLen;
ShlOfs = DivOfs + InterOpLen + ShxLen;
ShrOfs = ShlOfs + InterOpLen + ShxLen;
procedure Install_386_Ops;
type
PtrPtr = ^ pointer;
var
Src: pointer;
Dst: record
case word of
2: (Ofs, Seg: word);
4: (Ptr: pointer);
end;
DstPtr: record
case word of
2: (Ofs, Seg: word);
4: (Ptr: PtrPtr);
end;
{$ifdef Windows}
var
TpwBug: boolean;
{$endif}
begin
{$ifdef Windows}
TpwBug := Ofs(Dummy) = (Ofs(Dummy) + MulOfs);
{Bug is in 1.0 and 1.5, but not in 2.0 (I hope!)}
{$endif}
DstPtr.Seg := Seg(Dummy); {Segment of the ptr to the RTL code}
{multiplication}
DstPtr.Ofs := Ofs(Dummy) + MulOfs;
{$ifdef Windows} if TpwBug then Inc(DstPtr.Ofs, MulOfs); {$endif}
{Undoubtedly the worst compiler bug I've ever seen in Turbo Pascal!}
Dst.Ptr := DstPtr.Ptr^; {Read obj code; get ptr to RTL}
{$ifdef Windows}
Dst.Seg := AllocCStoDSAlias(Dst.Seg);
{$ifopt R+} if Dst.Seg = 0 then RunError(201); {$endif}
{$endif}
Src := @ LongMul386;
Move(Src^, Dst.Ptr^, Ofs(LongDivMod386) - Ofs(LongMul386));
{div and mod}
DstPtr.Ofs := Ofs(Dummy) + DivOfs;
{$ifdef Windows} if TpwBug then Inc(DstPtr.Ofs, DivOfs); {$endif}
Dst.Ofs := Ofs(DstPtr.Ptr^^);
Src := @ LongDivMod386;
Move(Src^, Dst.Ptr^, Ofs(LongShr386) - Ofs(LongDivMod386));
{shr}
DstPtr.Ofs := Ofs(Dummy) + ShrOfs;
{$ifdef Windows} if TpwBug then Inc(DstPtr.Ofs, ShrOfs); {$endif}
Dst.Ofs := Ofs(DstPtr.Ptr^^);
Src := @ LongShr386;
Move(Src^, Dst.Ptr^, Ofs(LongShl386) - Ofs(LongShr386));
{shl}
DstPtr.Ofs := Ofs(Dummy) + ShlOfs;
{$ifdef Windows} if TpwBug then Inc(DstPtr.Ofs, ShlOfs); {$endif}
Dst.Ofs := Ofs(DstPtr.Ptr^^);
Src := @ LongShl386;
Move(Src^, Dst.Ptr^, Ofs(TailPtr) - Ofs(LongShl386) );
{$ifdef Windows}
FreeSelector(Dst.Seg);
{$endif}
end;
end.